home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJPICT3.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  3.4 KB  |  135 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjPicture"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Public objects As New Collection
  11.  
  12. Const TYPE_STRING = "3D APF PICTURE"
  13.  
  14.  
  15. ' ************************************************
  16. ' Find an object that contains this point.
  17. ' ************************************************
  18. Function NearestObject(x As Single, y As Single) As Object
  19. Dim obj As Object
  20.        
  21.     ' Find the object.
  22.     For Each obj In objects
  23.         If obj.Contains(x, y) Then
  24.             Set NearestObject = obj
  25.             Exit Function
  26.         End If
  27.     Next obj
  28.     Set NearestObject = Nothing
  29. End Function
  30.  
  31.  
  32. Function ObjectType() As String
  33.     ObjectType = TYPE_STRING
  34. End Function
  35.  
  36.  
  37.  
  38. ' ************************************************
  39. ' Read the picture from a file using Input.
  40. ' Assume TYPE_STRING has already been read.
  41. ' ************************************************
  42. Sub FileInput(filenum As Integer)
  43. Dim num As Integer
  44. Dim i As Integer
  45. Dim obj As Object
  46. Dim obj_type As String
  47.  
  48.     ' Read the number of objects in the file.
  49.     Input #filenum, num
  50.     
  51.     ' Repeatedly read objects from the file.
  52.     For i = 1 To num
  53.         Input #filenum, obj_type
  54.         Select Case obj_type
  55.             Case TYPE_STRING
  56.                 Set obj = New ObjPicture
  57.             Case "POLYLINE"
  58.                 Set obj = New ObjPolyline
  59.             Case "GRID"
  60.                 Set obj = New ObjGrid3D
  61.             Case "SPARSE_GRID"
  62.                 Set obj = New ObjSparseGrid
  63.             Case Else
  64.                 Beep
  65.                 MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
  66.                 Exit Sub
  67.         End Select
  68.         obj.FileInput filenum
  69.         objects.Add obj
  70.     Next i
  71. End Sub
  72.  
  73. ' ************************************************
  74. ' Draw the picture on a Form, Printer, or
  75. ' PictureBox.
  76. ' ************************************************
  77. Sub Draw(canvas As Object, Optional R As Variant)
  78. Dim obj As Object
  79.  
  80.     For Each obj In objects
  81.         obj.Draw canvas, R
  82.     Next obj
  83. End Sub
  84.  
  85. ' ************************************************
  86. ' Write the picture to a file using Write.
  87. ' Begin with TYPE_STRING to identify this object.
  88. ' ************************************************
  89. Sub FileWrite(filenum As Integer)
  90. Dim obj As Object
  91.  
  92.     Write #filenum, TYPE_STRING
  93.     Write #filenum, objects.Count
  94.     
  95.     For Each obj In objects
  96.         obj.FileWrite filenum
  97.     Next obj
  98. End Sub
  99.  
  100. ' ************************************************
  101. ' Apply a nonlinear transformation to the objects.
  102. ' ************************************************
  103. Sub Distort(trans As Object)
  104. Dim obj As Object
  105.  
  106.     For Each obj In objects
  107.         obj.Distort trans
  108.     Next obj
  109. End Sub
  110.  
  111.  
  112. ' ************************************************
  113. ' Apply a transformation matrix which may not
  114. ' contain 0, 0, 0, 1 in the last column to the
  115. ' objects.
  116. ' ************************************************
  117. Sub ApplyFull(M() As Single)
  118. Dim obj As Object
  119.  
  120.     For Each obj In objects
  121.         obj.ApplyFull M
  122.     Next obj
  123. End Sub
  124. ' ************************************************
  125. ' Apply a transformation matrix to the objects.
  126. ' ************************************************
  127. Sub Apply(M() As Single)
  128. Dim obj As Object
  129.  
  130.     For Each obj In objects
  131.         obj.Apply M
  132.     Next obj
  133. End Sub
  134.  
  135.